PC Home 49/PC_Home_Issue_49.iso/lldemo/lldemo.shr/ROSETTA.EXE/ROSETTA.DXR/00177_diagnostic routines.ls

Text File | 1996-06-24 | 21.8 KB | 747 lines

global gProcs, gGlobs

on makeTextList
  repeat with i = 1 to the number of castMembers
    if (the castType of cast i = #text) or (the castType of cast i = #button) then
      put i && the textFont of cast i && the textHeight of cast i && the textSize of cast i && the textStyle of cast i
    end if
  end repeat
end

on findCastInScore c
  set str to "cast " & c & " used in: "
  repeat with i = 1 to the lastFrame
    go(i)
    repeat with sP = 1 to 48
      if the castNum of sprite sP = c then
        put i & ", " after str
      end if
      if the scriptNum of sprite sP = c then
        put i & ", " after str
      end if
    end repeat
  end repeat
  return str
end

on getSpriteLocs
  repeat with s = 1 to 29
    set strH to "sprite " & s & " locH: "
    set strV to "sprite " & s & " locV: "
    repeat with i = 51 to 165
      go(i)
      if the castNum of sprite s <> 0 then
        put the locH of sprite s & "," after strH
        put the locV of sprite s & "," after strV
      end if
    end repeat
    put strH
    put strV
  end repeat
  return(str)
end

on dumpText
  set saveFile to FileIO(mnew, "?write", "outFile")
  if objectp(saveFile) then
    repeat with i = 1 to 1000
      if the scriptText of cast i <> EMPTY then
        set t to the scriptText of cast i
        saveFile(mWriteString, RETURN & "$ " & i & RETURN)
        saveFile(mWriteString, t)
      end if
    end repeat
    saveFile(mdispose)
  else
    alert("Couldn't open file")
  end if
end

on getUsedScoreScripts
  set ss to []
  repeat with i = 1 to 200
    go(i)
    set s to the frameScript
    if (s <> 0) and (getPos(ss, s) = 0) then
      add(ss, s)
    end if
    repeat with j = 1 to 48
      set s to the scriptNum of sprite j
      if (s <> 0) and (getPos(ss, s) = 0) then
        add(ss, s)
      end if
    end repeat
  end repeat
  sort(ss)
  put ss
end

on getAllScoreScripts
  set ss to []
  repeat with i = 1 to the number of castMembers
    if the castType of cast i = #script then
      add(ss, i)
    end if
  end repeat
  put ss
end

on closeProc proc, script, gList, pList, Locals
  if proc <> EMPTY then
    put "Proc: " & proc & " (" & script & ")"
  else
    put "Script: " & script
  end if
  if gList <> [] then
    put "    Globals: " & printList(gList, 1)
  end if
  if pList <> [] then
  end if
  if Locals <> "," then
    delete char 1 of Locals
    delete char length(Locals) of Locals
  end if
end

on addList base, sP
  set ret to existList(base, sP)
  if ret = 0 then
    add(base, [#s: sP, #count: 0, #glob: []])
    set ret to count(base)
  end if
  return ret
end

on existList base, sP
  set c to count(base)
  repeat with i = 1 to c
    if getaProp(getAt(base, i), #s) = sP then
      return i
    end if
  end repeat
  return 0
end

on tallyList base, sP
  set i to existList(base, sP)
  if i <> 0 then
    set l to getAt(base, i)
    setaProp(l, #count, getaProp(l, #count) + 1)
    return 1
  end if
  return 0
end

on tallyListScript base, sP, num
  set i to existList(base, sP)
  if i <> 0 then
    set l to getAt(base, i)
    setaProp(l, #count, getaProp(l, #count) + 1)
    set numlis to getaProp(l, #scripts)
    if voidp(numlis) then
      set numlis to [num]
    else
      add(numlis, num)
    end if
    setaProp(l, #scripts, numlis)
    return 1
  end if
  return 0
end

on tallyListProc base, sP, pr
  set i to existList(base, sP)
  if i <> 0 then
    set l to getAt(base, i)
    set prlis to getaProp(l, #procs)
    if voidp(prlis) then
      set prlis to [pr]
    else
      if getOne(prlis, pr) = 0 then
        add(prlis, pr)
      end if
    end if
    setaProp(l, #procs, prlis)
    return 1
  end if
  return 0
end

on printList base, markUnused
  set st to EMPTY
  set c to count(base)
  set prolog to EMPTY
  repeat with i = 1 to c
    set l to getAt(base, i)
    if (markUnused = 1) and (getaProp(l, #count) = 0) then
      set flag to "*"
    else
      set flag to " "
    end if
    put prolog & flag & getaProp(l, #s) after st
    set prolog to ", "
  end repeat
  return st
end

on makeGlobalList
  set gGlobs to []
  set gProcs to []
  set xcount to 0
  repeat with currcast = 1 to the number of castMembers
    if the scriptText of cast currcast <> EMPTY then
      set scrip to the scriptText of cast currcast
      put "cast: " & currcast
      set currProc to EMPTY
      set numlines to the number of lines in scrip
      repeat with ln = 1 to numlines
        set s to line ln of scrip
        if offset("--", s) <> 0 then
          set s to char 1 to offset("--", s) - 1 of s
        end if
        set st to #xAny
        set packet to getTok(s)
        set s to getaProp(packet, #s)
        set dest to getaProp(packet, #dest)
        repeat while dest <> EMPTY
          if st = #xAny then
            if dest = "on" then
              set st to #xProc
            else
              if dest = "global" then
                set st to #xGlobal
              else
                if dest = "end" then
                  set st to #xEnd
                else
                  if dest = QUOTE then
                    set st to #xQuote
                  end if
                end if
              end if
            end if
          else
            if st = #xGlobal then
              if dest <> "," then
                put "global: " & dest
                addList(gGlobs, dest)
                if currProc <> EMPTY then
                  add(getaProp(getAt(gProcs, procnum), #glob), dest)
                end if
              end if
            else
              if st = #xQuote then
                if dest = QUOTE then
                  set st to #xAny
                end if
              else
                if st = #xEnd then
                  if (dest <> "if") and (dest <> "repeat") then
                    set currProc to EMPTY
                  end if
                  set st to #xAny
                else
                  if st = #xProc then
                    put "proc: " & dest
                    set procnum to addList(gProcs, dest)
                    setaProp(getAt(gProcs, procnum), #cast, currcast)
                    set currProc to dest
                    set st to #xAny
                  end if
                end if
              end if
            end if
          end if
          set packet to getTok(s)
          set s to getaProp(packet, #s)
          set dest to getaProp(packet, #dest)
        end repeat
      end repeat
    end if
  end repeat
  put "finished global list"
end

on analyzeCode
  makeGlobalList()
  makeTree()
end

on makeTree
  global gKeywords, gEnumList
  put "Is the Global List Updated? - Call makeGlobalList first"
  set currProc to EMPTY
  set ggList to []
  set gpList to []
  set gEnumList to []
  set ScriptGlob to []
  set gKeywords to ",go,the,frame,if,clickOn,then,puppetSprite,FALSE,set,keydownscript,put,nothing,mouseH,and,mouseV,into,doubleClick,top,of,sprite,bottom,left,right,integer,number,lines,in,field,line,spriteBox,updateStage,castNum,to,cast,else,locH,fileio,mNew,objectp,mWriteString,RETURN,date,text,time,after,value,alert,mDispose,repeat,with,scriptText,empty,frameScript,getPos,add,sort,castmembers,casttype,script,TRUE,count,getaProp,getAt,setaProp,offset,char,while,QUOTE,chartonum,or,word,delete,halt,when,timeOut,textCast,locV,playFile,ticks,startTicks,soundBusy,stop,stillDown,lastClick,enabled,menuItem,menu,textFont,textStyle,random,foreColor,cursor,label,timeoutLength,exitLock,colorDepth,pathName,items,not,string,length,numtochar,mReadLine,key,dontPassEvent,rollOver,volume,TAB,fileObj,mReadFile,do,maxInteger,getNthFileNameInFolder,exit,append,immediate,mod,puppetTransition,keyDown,commandDown,chars,endTicks,picture,width,textSize,textAlign,voidP,mGet,mPut,puppetSound,mci,factory,machineType,"
  set Locals to ","
  set c to count(gProcs)
  repeat with i = 1 to c
    setaProp(getAt(gProcs, i), #count, 0)
  end repeat
  set c to count(gGlobs)
  repeat with i = 1 to c
    setaProp(getAt(gGlobs, i), #count, 0)
  end repeat
  repeat with currcast = 1 to the number of castMembers
    if the scriptText of cast currcast <> EMPTY then
      set scrip to the scriptText of cast currcast
      set ScriptGlob to []
      set numlines to the number of lines in scrip
      repeat with ln = 1 to numlines
        set s to line ln of scrip
        if offset("--", s) <> 0 then
          set s to char 1 to offset("--", s) - 1 of s
        end if
        set st to #xAny
        set packet to getTok(s)
        set s to getaProp(packet, #s)
        set dest to getaProp(packet, #dest)
        repeat while dest <> EMPTY
          if st = #xAny then
            if dest = "on" then
              set st to #xProc
            else
              if dest = "global" then
                set st to #xGlobal
              else
                if dest = QUOTE then
                  set st to #xQuote
                else
                  if dest = "end" then
                    set st to #xEnd
                  else
                    if dest = "#" then
                      set st to #xEnum
                    else
                      if isalpha(char 1 of dest) then
                        if offset("," & dest & ",", gKeywords) = 0 then
                          if offset("," & dest & ",", Locals) = 0 then
                            if existList(gGlobs, dest) then
                              if tallyList(ggList, dest) = 0 then
                                if tallyList(ScriptGlob, dest) = 0 then
                                  put "*" & currProc & ": Global not declared: " & dest
                                end if
                              end if
                            else
                              if existList(gProcs, dest) then
                                addList(gpList, dest)
                                tallyList(gProcs, dest)
                              else
                                put dest & "," after Locals
                              end if
                            end if
                          end if
                        end if
                      end if
                    end if
                  end if
                end if
              end if
            end if
          else
            if st = #xGlobal then
              if (dest <> EMPTY) and (dest <> ",") then
                if currProc = EMPTY then
                  addList(ScriptGlob, dest)
                else
                  addList(ggList, dest)
                end if
              end if
            else
              if st = #xQuote then
                if dest = QUOTE then
                  set st to #xAny
                end if
              else
                if st = #xEnum then
                  if existList(gEnumList, dest) then
                    tallyList(gEnumList, dest)
                  else
                    addList(gEnumList, dest)
                  end if
                  set st to #xAny
                else
                  if st = #xEnd then
                    if (dest <> "repeat") and (dest <> "if") and (dest <> currProc) then
                      put "*" & currProc & ": check argument after 'end'"
                    end if
                    if dest = currProc then
                      closeProc(currProc, currcast, ggList, gpList, Locals)
                      set ggList to []
                      set gpList to []
                      set Locals to ","
                      set currProc to EMPTY
                    end if
                    set st to #xAny
                  else
                    if st = #xProc then
                      set currProc to dest
                      set st to #xAny
                    end if
                  end if
                end if
              end if
            end if
          end if
          set packet to getTok(s)
          set s to getaProp(packet, #s)
          set dest to getaProp(packet, #dest)
        end repeat
        if st = #xEnd then
          put "*'end' should have an argument"
          if currProc <> EMPTY then
            closeProc(currProc, currcast, ggList, gpList, Locals)
            set ggList to []
            set gpList to []
            set Locals to ","
          end if
        end if
      end repeat
      if currProc <> EMPTY then
        put "*" & currProc && "was not closed out"
        closeProc(currProc, currcast, ggList, gpList, Locals)
        set ggList to []
        set gpList to []
        set Locals to ","
        set currProc to EMPTY
      end if
      if ScriptGlob <> [] then
        put "Script Globals: " & printList(ScriptGlob, 1)
      end if
    end if
  end repeat
  put "Procedures not called:"
  repeat with i = 1 to c
    set cl to getAt(gProcs, i)
    if getaProp(cl, #count) = 0 then
      put "    " & getaProp(cl, #s)
    end if
  end repeat
end

on isalpha c
  set i to charToNum(c)
  if ((i >= 65) and (i <= 90)) or ((i >= 97) and (i <= 122)) then
    return 1
  else
    return 0
  end if
end

on isdigit c
  set i to charToNum(c)
  if (i >= 48) and (i <= 57) then
    return 1
  else
    return 0
  end if
end

on isprint c
  set i to charToNum(c)
  if i >= 33 then
    return 1
  else
    return 0
  end if
end

on isalnum c
  if isalpha(c) or isdigit(c) then
    return 1
  else
    return 0
  end if
end

on getTok sP
  set w to word 1 of sP
  set ch to char 1 of w
  if w = EMPTY then
    set sP to EMPTY
    set done to 1
  else
    if isdigit(ch) then
      set state to #tsNum
    else
      if isalpha(ch) then
        set state to #tsToken
      else
        if isprint(ch) then
          set state to #tsSymbol
        else
          put "Huh? (" & charToNum(ch) & ") " & sP
          set sP to EMPTY
          set done to 1
        end if
      end if
    end if
  end if
  set howmany to 0
  repeat while done = 0
    set howmany to howmany + 1
    set ch to char howmany of w
    if state = #tsNum then
      if isdigit(ch) = 0 then
        set done to 1
        set howmany to howmany - 1
      end if
      next repeat
    end if
    if state = #tsToken then
      if isalnum(ch) = 0 then
        set done to 1
        set howmany to howmany - 1
      end if
      next repeat
    end if
    if state = #tsSymbol then
      set done to 1
    end if
  end repeat
  set dP to char 1 to howmany of w
  set white to offset(dP, sP) - 1
  delete char 1 to howmany + white of sP
  return [#s: sP, #dest: dP]
end

on tree pr
  printRoutine(pr, 1)
end

on printRoutine pr, level
  set procnum to existList(gProcs, pr)
  if procnum = 0 then
    put "Couldn't find proc: " & pr
    halt()
  end if
  set space to EMPTY
  repeat with i = 1 to level
    put "  " after space
  end repeat
  put space & pr & " (" & formatList(getaProp(getAt(gProcs, procnum), #glob)) & ") [" & getaProp(getAt(gProcs, procnum), #cast) & "]"
  set scrip to the scriptText of cast getaProp(getAt(gProcs, procnum), #cast)
  set numlines to the number of lines in scrip
  set st to #xBefore
  repeat with ln = 1 to numlines
    set s to line ln of scrip
    if offset("--", s) <> 0 then
      set s to char 1 to offset("--", s) - 1 of s
    end if
    set packet to getTok(s)
    set s to getaProp(packet, #s)
    set dest to getaProp(packet, #dest)
    repeat while dest <> EMPTY
      if st = #xBefore then
        if dest = "on" then
          set st to #xBefore1
        end if
      else
        if st = #xBefore1 then
          if dest = pr then
            set st to #xAny
          else
            set st to #xBefore
          end if
        else
          if st = #xAny then
            if dest = QUOTE then
              set st to #xQuote
            else
              if dest = "end" then
                set st to #xEnd
              else
                if isalpha(char 1 of dest) then
                  set isProc to existList(gProcs, dest)
                  if isProc then
                    printRoutine(dest, level + 1)
                  end if
                end if
              end if
            end if
          else
            if st = #xQuote then
              if dest = QUOTE then
                set st to #xAny
              end if
            else
              if st = #xEnd then
                if (dest = "repeat") or (dest = "if") then
                  set st to #xAny
                else
                  if dest = pr then
                    set st to #xAfter
                  else
                    put pr & ": check argument after 'end'"
                    set st to #xAfter
                  end if
                end if
              end if
            end if
          end if
        end if
      end if
      if st = #xAfter then
        return
      end if
      set packet to getTok(s)
      set s to getaProp(packet, #s)
      set dest to getaProp(packet, #dest)
    end repeat
  end repeat
end

on formatList lis
  set st to EMPTY
  set c to count(lis)
  repeat with i = 1 to c
    if i <> 1 then
      put ", " after st
    end if
    put getAt(lis, i) after st
  end repeat
  return st
end

on countGlobals
  global gKeywords, gEnumList
  put "Is the Global List Updated? - Call makeGlobalList first"
  set currProc to EMPTY
  set ggList to []
  set gpList to []
  set gEnumList to []
  set ScriptGlob to []
  set Locals to ","
  set c to count(gProcs)
  set gKeywords to ",go,the,frame,if,clickOn,then,puppetSprite,FALSE,set,keydownscript,put,nothing,mouseH,and,mouseV,into,doubleClick,top,of,sprite,bottom,left,right,integer,number,lines,in,field,line,spriteBox,updateStage,castNum,to,cast,else,locH,fileio,mNew,objectp,mWriteString,RETURN,date,text,time,after,value,alert,mDispose,repeat,with,scriptText,empty,frameScript,getPos,add,sort,castmembers,casttype,script,TRUE,count,getaProp,getAt,setaProp,offset,char,while,QUOTE,chartonum,or,word,delete,halt,when,timeOut,textCast,locV,playFile,ticks,startTicks,soundBusy,stop,stillDown,lastClick,enabled,menuItem,menu,textFont,textStyle,random,foreColor,cursor,label,timeoutLength,exitLock,colorDepth,pathName,items,not,string,length,numtochar,mReadLine,key,dontPassEvent,rollOver,volume,TAB,fileObj,mReadFile,do,maxInteger,getNthFileNameInFolder,exit,append,immediate,mod,puppetTransition,keyDown,commandDown,chars,endTicks,picture,width,textSize,textAlign,voidP,mGet,mPut,puppetSound,mci,factory,machineType,"
  repeat with i = 1 to c
    setaProp(getAt(gProcs, i), #count, 0)
  end repeat
  set c to count(gGlobs)
  repeat with i = 1 to c
    setaProp(getAt(gGlobs, i), #count, 0)
  end repeat
  repeat with currcast = 1 to the number of castMembers
    if the scriptText of cast currcast <> EMPTY then
      set scrip to the scriptText of cast currcast
      put "cast: " & currcast
      set ScriptGlob to []
      set numlines to the number of lines in scrip
      repeat with ln = 1 to numlines
        set s to line ln of scrip
        if offset("--", s) <> 0 then
          set s to char 1 to offset("--", s) - 1 of s
        end if
        set st to #xAny
        set packet to getTok(s)
        set s to getaProp(packet, #s)
        set dest to getaProp(packet, #dest)
        repeat while dest <> EMPTY
          if st = #xAny then
            if dest = "on" then
              set st to #xProc
            else
              if dest = "global" then
                set st to #xGlobal
              else
                if dest = QUOTE then
                  set st to #xQuote
                else
                  if isalpha(char 1 of dest) then
                    if offset("," & dest & ",", gKeywords) = 0 then
                      if existList(gGlobs, dest) then
                        tallyListProc(gGlobs, dest, currProc && currcast)
                      end if
                    end if
                  end if
                end if
              end if
            end if
          else
            if st = #xGlobal then
              if (dest <> EMPTY) and (dest <> ",") then
                if currProc = EMPTY then
                  addList(ScriptGlob, dest)
                else
                  addList(ggList, dest)
                end if
              end if
            else
              if st = #xQuote then
                if dest = QUOTE then
                  set st to #xAny
                end if
              else
                if st = #xEnum then
                  if existList(gEnumList, dest) then
                    tallyList(gEnumList, dest)
                  else
                    addList(gEnumList, dest)
                  end if
                  set st to #xAny
                else
                  if st = #xEnd then
                    if (dest <> "repeat") and (dest <> "if") and (dest <> currProc) then
                    end if
                    if dest = currProc then
                      closeProc(currProc, currcast, ggList, gpList, Locals)
                      set ggList to []
                      set gpList to []
                      set Locals to ","
                      set currProc to EMPTY
                    end if
                    set st to #xAny
                  else
                    if st = #xProc then
                      set currProc to dest
                      set st to #xAny
                    end if
                  end if
                end if
              end if
            end if
          end if
          set packet to getTok(s)
          set s to getaProp(packet, #s)
          set dest to getaProp(packet, #dest)
        end repeat
        if st = #xEnd then
          if currProc <> EMPTY then
            closeProc(currProc, currcast, ggList, gpList, Locals)
            set ggList to []
            set gpList to []
            set Locals to ","
          end if
        end if
      end repeat
      if currProc <> EMPTY then
        closeProc(currProc, currcast, ggList, gpList, Locals)
        set ggList to []
        set gpList to []
        set Locals to ","
        set currProc to EMPTY
      end if
      if ScriptGlob <> [] then
      end if
    end if
  end repeat
end

on printGlobalList
  global gGlobs
  set lis to []
  set n to count(gGlobs)
  repeat with i = 1 to n
    set s to getaProp(getAt(gGlobs, i), #s)
    put ": " after s
    set scr to getaProp(getAt(gGlobs, i), #procs)
    put string(scr) after s
    add(lis, s)
  end repeat
  sort(lis)
  put string(lis)
end